home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue43 / delay / ExpImpTestDll.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-01-24  |  1.6 KB  |  75 lines
  1. unit ExpImpTestDll;
  2.  
  3. interface
  4.  
  5. var
  6.   Routine1 : procedure (A, B, C, D: integer); register;
  7.   Routine2 : procedure (A, B, C, D: integer); pascal;
  8.   Routine3 : procedure (A, B, C, D: integer); cdecl;
  9.   Routine4 : procedure (A, B, C, D: integer); stdcall;
  10.  
  11. implementation
  12.  
  13. uses
  14.   Windows,
  15.   SysUtils,
  16.   Dialogs;
  17.  
  18. var
  19.   TestDllModule: HModule = 0;
  20.  
  21. procedure RaiseLastWin32Error;
  22. begin
  23.   raise Exception.Create('Win32 Error!');
  24. end;
  25.  
  26. function GetTestDllModule: HModule;
  27. begin
  28.   if TestDllModule = 0 then
  29.   begin
  30.     TestDllModule := Windows.LoadLibrary('TestDll.Dll');
  31.     if TestDllModule = 0 then
  32.       RaiseLastWin32Error;
  33.   end;
  34.   Result := TestDllModule;
  35. end;
  36.  
  37. function GetTestDllFunc(const ProcName: string): FarProc;
  38. begin
  39.   Result := Windows.GetProcAddress(GetTestDllModule, PChar(ProcName));
  40.   if Result = nil then
  41.     RaiseLastWin32Error;
  42. end;
  43.  
  44. procedure Routine1_Thunk(A, B, C, D: integer); register;
  45. begin
  46.   Routine1 := GetTestDllFunc('Routine1');
  47.   Routine1(A, B, C, D);
  48. end;
  49.  
  50. procedure Routine2_Thunk(A, B, C, D: integer); pascal;
  51. begin
  52.   Routine2 := GetTestDllFunc('Routine2');
  53.   Routine2(A, B, C, D);
  54. end;
  55.  
  56. procedure Routine3_Thunk(A, B, C, D: integer); cdecl;
  57. begin
  58.   Routine3 := GetTestDllFunc('Routine3');
  59.   Routine3(A, B, C, D);
  60. end;
  61.  
  62. procedure Routine4_Thunk(A, B, C, D: integer); stdcall;
  63. begin
  64.   Routine4 := GetTestDllFunc('Routine4');
  65.   Routine4(A, B, C, D);
  66. end;
  67.  
  68. initialization
  69.   Routine1 := Routine1_Thunk;
  70.   Routine2 := Routine2_Thunk;
  71.   Routine3 := Routine3_Thunk;
  72.   Routine4 := Routine4_Thunk;
  73.  
  74. end.
  75.